Professional Soft Collection 1.02/Professional Soft Collection 1.02.iso/communic/qmodempr/script.pak/HOSTFILE.SCR

Text File | 1994-03-01 | 5.9 KB | 209 lines

' File area routines for host mode.

function GetProtocol as integer
  dim s as string
  if not DisplayFile(ProtocolFileName) then
    send #Port, "Select a file transfer protocol:"
    send #Port,
    send #Port, "[A] Ascii  [X] Xmodem   [C] Xmodem/CRC  [1] Xmodem/1K  [F] Xmodem/1KG"
    send #Port, "[Y] Ymodem [G] Ymodem/G [Z] Zmodem      [K] Kermit"
  end if
  send #Port,
  s = GetLine("Protocol: ")
  select case OemUpper(left(s, 1))
    case "A"
      GetProtocol = ASCII
    case "X"
      GetProtocol = Xmodem
    case "C"
      GetProtocol = XmodemCRC
    case "1"
      GetProtocol = Xmodem1K
    case "F"
      GetProtocol = Xmodem1KG
    case "Y"
      GetProtocol = Ymodem
    case "G"
      GetProtocol = YmodemG
    case "Z"
      GetProtocol = Zmodem
    case "K"
      GetProtocol = Kermit
  end select
end function

function ProtocolName(prot as integer) as string
  select case prot
    case ASCII
      ProtocolName = "ASCII"
    case Xmodem
      ProtocolName = "Xmodem"
    case XmodemCRC
      ProtocolName = "Xmodem/CRC"
    case Xmodem1K
      ProtocolName = "Xmodem/1K"
    case Xmodem1KG
      ProtocolName = "Xmodem/1KG"
    case Ymodem
      ProtocolName = "Ymodem"
    case YmodemG
      ProtocolName = "Ymodem/G"
    case Zmodem
      ProtocolName = "Zmodem"
    case Kermit
      ProtocolName = "Kermit"
  end select
end function

' List files

sub ListFiles
  dim result as integer, count as integer, total as integer, sr as SearchRec
  if Setup.dlpath = "" then
    send #Port,
    send #Port, "Sorry, downloads are not available."
    send #Port,
    exit sub
  end if
  total = 0
  count = 0
  result = FindFirst(AddBackSlash(Setup.dlpath)+"*.*", 0, sr)
  do while result = 0 and not CallerHungUp
    dim i as integer
    i = instr(sr.name, ".")
    if i > 0 then
      send #Port, left(sr.name, i-1); tab(10); right(sr.name, len(sr.name)-i); tab(14);
    else
      send #Port, sr.name; tab(14);
    end if
    send #Port, space(11-len(str(sr.size))); sr.size;
    send #Port, DateToDateString(" mm-dd-yy", DMYtoDate(sr.date and 0x1f, (sr.date\32) and 0xf, 1980+(sr.date\512)));
    send #Port, TimeToTimeString(" HH:mmt", HMStoTime(sr.time\2048, (sr.time\32) and 0x3f, (sr.time and 0x1f) * 2));
    send #Port,
    total = total + 1
    count = count + 1
    if count >= 24 then
      if OemUpper(GetLine("-Pause- [C]ontinue, [S]top? ", 1)) = "S" then
        exit do
      end if
      count = 0
    end if
    result = FindNext(sr)
  loop
  send #Port,
  send #Port, total; " file(s) available"
  send #Port,
  GetLine "Press Enter to continue? "
end sub

' Download file

sub DownloadFile
  dim fnames as string, protocol as integer, count as integer
  dim onefile as integer
  if Setup.dlpath = "" then
    send #Port,
    send #Port, "Sorry, downloads are not available."
    send #Port,
    exit sub
  end if
  protocol = GetProtocol()
  if protocol = 0 then exit sub
  onefile = protocol < Ymodem
  do
    dim s as string
    s = GetLine("File to download: ")
    if CallerHungUp then
      exit sub
    end if
    if s = "" then exit do
    send #Port,
    if Setup.sysopanypath = 0 or User.Level = 0 then
      s = AddBackSlash(Setup.dlpath)+JustFilename(s)
      print "not sysop"
    elseif instr(s, "\") = 0 then
      s = AddBackSlash(Setup.dlpath)+JustFilename(s)
      print "no backslash"
    end if
    dim sr as SearchRec
    if findfirst(s, 0, sr) = 0 then
      do
        if len(fnames) > 0 then
          fnames = fnames + " "
        end if
        fnames = fnames + AddBackSlash(JustPathName(s)) + sr.Name
        count = count + 1
        dim i as integer
        i = instr(sr.name, ".")
        if i > 0 then
          send #Port, left(sr.name, i-1); tab(10); right(sr.name, len(sr.name)-i); tab(14);
        else
          send #Port, sr.name; tab(14);
        end if
        send #Port, space(11-len(str(sr.size))); sr.size;
        send #Port, DateToDateString(" mm-dd-yy", DMYtoDate(sr.date and 0x1f, (sr.date\32) and 0xf, 1980+(sr.date\512)));
        send #Port, TimeToTimeString(" HH:mmt", HMStoTime(sr.time\2048, (sr.time\32) and 0x3f, (sr.time and 0x1f) * 2));
        send #Port,
      loop until (onefile and count = 1) or findnext(sr) <> 0
      send #Port,
    else
      send #Port, "The file "; s; " could not be found on disk."
    end if
  loop until onefile and count = 1
  if count > 0 then
    if Local then
      send #Port, "The following files would be transferred if you were not on locally:"
      send #Port, fnames
    else
      send #Port,
      send #Port, "Begin your "; ProtocolName(protocol); " download of ";
      if count = 1 then
        send #Port, fnames;
      else
        send #Port, count, " files"
      end if
      send #Port, " now"
      delay 1
      sendfile fnames, protocol
    end if
  else
    send #Port, "No files selected."
  end if
end sub

' Upload file

sub UploadFile
  dim fname as string, protocol as integer
  if Setup.ulpath = "" then
    send #Port,
    send #Port, "Sorry, uploads are not available."
    send #Port,
    exit sub
  end if
  if Local then
    send #Port, "Uploads not available when logged on locally"
    exit sub
  end if
  protocol = GetProtocol()
  if protocol = 0 or CallerHungUp then exit sub
  send #Port,
  fname = "your file"
  if protocol < Ymodem then
    fname = GetLine("File to upload: ")
    send #Port,
    if fname = "" or CallerHungUp then exit sub
    fname = AddBackSlash(Setup.ulpath)+JustFilename(fname)
    if exists(fname) then
      send #Port, "The file "; fname; " already exists on disk."
      exit sub
    end if
    send #Port, "Begin your "; ProtocolName(protocol); " upload of "; fname; " now"
  else
    fname = Setup.ulpath
    send #Port, "Begin your "; ProtocolName(protocol); " upload of your file now"
  end if
  delay 1
  receivefile fname, protocol
end sub